home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagd_f.zip / DOS.SWG / 0042_Relative paths.pas < prev    next >
Pascal/Delphi Source File  |  1994-01-27  |  2KB  |  86 lines
  1. {
  2. bcp100@cd4680fs.rrze.uni-erlangen.de (Peter Gedeck)
  3.  
  4. : Does anyone have a relative path routine?   An example of what I mean by a
  5. : relative path routine is the Turbo Pascal IDE's editor window titles. It
  6. : only displays as much of the files path name as is necessary. It should be
  7. : something like
  8. :     function RelativePath(FullPath: string): string;
  9.  
  10. This is what I use to get a relative file name. I think it works correctly
  11. and hope you will find it useful.
  12. }
  13.  
  14. Uses
  15.   Dos;
  16.  
  17.  
  18. function GetCurDir : DirStr;
  19. var
  20.   CurDir : DirStr;
  21. begin
  22.   GetDir(0, CurDir);
  23.   GetCurDir := CurDir;
  24. end;
  25.  
  26.  
  27. function GetCurDrive : Char; assembler;
  28. asm
  29.   MOV     AH,19H
  30.   INT     21H
  31.   ADD     AL,'A'
  32. end;
  33.  
  34.  
  35. function GetRelativeFileName(F : String) : String;
  36. var
  37.   D  : DirStr;
  38.   N  : NameStr;
  39.   E  : ExtStr;
  40.   i  : integer;
  41.   rd : string;
  42.  
  43. begin
  44.   F := FExpand(F);
  45.   FSplit(F, D, N, E);
  46.   if GetCurDrive = D[1] then
  47.   begin
  48.     { Same Drive - remove Driveinformation from D }
  49.     Delete(D, 1, 2);
  50.     F := GetCurDir + '\';
  51.     Delete(F, 1, 2);
  52.     { Maybe it is a file in a directory higher than the actual directory }
  53.     i := Pos(F, d);
  54.     if i > 0 then
  55.       Delete(d, 1, length(F))
  56.     else
  57.     begin
  58.       rd := '';
  59.       if Pos(d, F) = 0 then
  60.       repeat
  61.         repeat
  62.           rd := d[Ord(d[0])] + rd;
  63.           dec(d[0]);
  64.         until d[Ord(d[0])] = '\';
  65.       until Pos(d, F) > 0;
  66.  
  67.       { Maybe it  is a file in a directory lower than the actual directory }
  68.       if Pos(d, F) > 0 then
  69.       begin
  70.         repeat
  71.           rd := '..\' + rd;
  72.           dec(F[0]);
  73.           while F[Ord(F[0])] <> '\' do
  74.             dec(F[0]);
  75.         until (Pos(d, F) > 0) and not ((d = '\') and (F <> '\'));
  76.         d := rd;
  77.       end;
  78.     end;
  79.   end;
  80.   GetRelativeFileName := (D + N + E);
  81. end;
  82.  
  83.  
  84. begin
  85.   Writeln(GetRelativeFileName('C:\qmpro\dl\bp\lib\ansi.pas'));
  86. end.